home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / DynaLoader / DynaLoader.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-31  |  6.9 KB  |  258 lines  |  [TEXT/MPS ]
  1. /* dl_dlopen.xs
  2.  * 
  3.  * Platform:    Macintosh CFM, possibly others which use dlopen.
  4.  * Author:    Matthias Neeracher <neeri@iis.ee.ethz.ch>
  5.  *        Adapted from dl_dlopen.xs reference implementation by
  6.  *              Paul Marquess (pmarquess@bfsec.bt.co.uk)
  7.  * $Log$
  8.  */
  9.  
  10. /* Porting notes:
  11.  
  12.  
  13.    Definition of Sunos dynamic Linking functions
  14.    =============================================
  15.    In order to make this implementation easier to understand here is a
  16.    quick definition of the SunOS Dynamic Linking functions which are
  17.    used here.
  18.  
  19.    dlopen
  20.    ------
  21.      void *
  22.      dlopen(path, mode)
  23.      char * path; 
  24.      int    mode;
  25.  
  26.      This function takes the name of a dynamic object file and returns
  27.      a descriptor which can be used by dlsym later. It returns NULL on
  28.      error.
  29.  
  30.      The mode parameter must be set to 1 for Solaris 1 and to
  31.      RTLD_LAZY on Solaris 2.
  32.  
  33.  
  34.    dlsym
  35.    ------
  36.      void *
  37.      dlsym(handle, symbol)
  38.      void * handle; 
  39.      char * symbol;
  40.  
  41.      Takes the handle returned from dlopen and the name of a symbol to
  42.      get the address of. If the symbol was found a pointer is
  43.      returned.  It returns NULL on error. If DL_PREPEND_UNDERSCORE is
  44.      defined an underscore will be added to the start of symbol. This
  45.      is required on some platforms (freebsd).
  46.  
  47.    dlerror
  48.    ------
  49.      char * dlerror()
  50.  
  51.      Returns a null-terminated string which describes the last error
  52.      that occurred with either dlopen or dlsym. After each call to
  53.      dlerror the error message will be reset to a null pointer. The
  54.      SaveError function is used to save the error as soo as it happens.
  55.  
  56.  
  57.    Return Types
  58.    ============
  59.    In this implementation the two functions, dl_load_file &
  60.    dl_find_symbol, return void *. This is because the underlying SunOS
  61.    dynamic linker calls also return void *.  This is not necessarily
  62.    the case for all architectures. For example, some implementation
  63.    will want to return a char * for dl_load_file.
  64.  
  65.    If void * is not appropriate for your architecture, you will have to
  66.    change the void * to whatever you require. If you are not certain of
  67.    how Perl handles C data types, I suggest you start by consulting    
  68.    Dean Roerich's Perl 5 API document. Also, have a look in the typemap 
  69.    file (in the ext directory) for a fairly comprehensive list of types 
  70.    that are already supported. If you are completely stuck, I suggest you
  71.    post a message to perl5-porters, comp.lang.perl or if you are really 
  72.    desperate to me.
  73.  
  74.    Remember when you are making any changes that the return value from 
  75.    dl_load_file is used as a parameter in the dl_find_symbol 
  76.    function. Also the return value from find_symbol is used as a parameter 
  77.    to install_xsub.
  78.  
  79.  
  80.    Dealing with Error Messages
  81.    ============================
  82.    In order to make the handling of dynamic linking errors as generic as
  83.    possible you should store any error messages associated with your
  84.    implementation with the StoreError function.
  85.  
  86.    In the case of SunOS the function dlerror returns the error message 
  87.    associated with the last dynamic link error. As the SunOS dynamic 
  88.    linker functions dlopen & dlsym both return NULL on error every call 
  89.    to a SunOS dynamic link routine is coded like this
  90.  
  91.     RETVAL = dlopen(filename, 1) ;
  92.     if (RETVAL == NULL)
  93.         SaveError("%s",dlerror()) ;
  94.  
  95.    Note that SaveError() takes a printf format string. Use a "%s" as
  96.    the first parameter if the error may contain and % characters.
  97.  
  98. */
  99.  
  100. #include "EXTERN.h"
  101. #include "perl.h"
  102. #include "XSUB.h"
  103. #include <TFileSpec.h>
  104.  
  105. #include <CodeFragments.h>
  106.  
  107.  
  108. #include "dlutils.c"    /* SaveError() etc    */
  109.  
  110. void CopyC2PStr(char * cstr, StringPtr pstr);
  111.  
  112.  
  113. static void
  114. dl_private_init()
  115. {
  116.     (void)dl_generic_private_init();
  117. }
  118.  
  119. XS(XS_DynaLoader_dl_load_file)
  120. {
  121.     dXSARGS;
  122.     if (items != 1) {
  123.     croak("Usage: DynaLoader::dl_load_file(filename)");
  124.     }
  125.     {
  126.     char *    filename = (char *)SvPV(ST(0),na);
  127.     ConnectionID    RETVAL;
  128.     OSErr        err;
  129.     FSSpec        spec;
  130.     ConnectionID    connID;
  131.     Ptr        mainAddr;
  132.     Str255        errName;
  133.     
  134.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  135.        err = Path2FSSpec(filename, &spec);
  136.         if (!err)
  137.             err = 
  138.             GetDiskFragment(
  139.                 &spec, 0, 0, spec.name, kLoadLib, &connID, &mainAddr, errName);
  140.         if (!err)
  141.             RETVAL = connID;
  142.         else
  143.              RETVAL = (ConnectionID) 0;
  144.         DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  145.         ST(0) = sv_newmortal() ;
  146.         if (err) {
  147.             errName[errName[0]] = 0;
  148.         SaveError("DynaLoader error [%d, \"%s\"]!", err, (char *) errName+1) ;
  149.         } else
  150.         sv_setiv( ST(0), (IV)RETVAL);
  151.     }
  152.     XSRETURN(1);
  153. }
  154.  
  155. XS(XS_DynaLoader_dl_find_symbol)
  156. {
  157.     dXSARGS;
  158.     if (items != 2) {
  159.     croak("Usage: DynaLoader::dl_find_symbol(connID, symbolname)");
  160.     }
  161.     {
  162.     ConnectionID    connID = (ConnectionID)SvIV(ST(0));
  163.     char *    symbolname = (char *)SvPV(ST(1),na);
  164.     void *    RETVAL;
  165.     OSErr        err;
  166.     Str255        symbol;
  167.     Ptr            symAddr;
  168.     SymClass        symClass;
  169.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  170.     connID, symbolname));
  171.     CopyC2PStr(symbolname, symbol);
  172.     err = FindSymbol(connID, symbol, &symAddr, &symClass);
  173.     if (err)
  174.         symAddr = (Ptr) 0;
  175.     RETVAL = (void *) symAddr;
  176.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  177.     ST(0) = sv_newmortal() ;
  178.     if (err)
  179.     SaveError("DynaLoader error [%d]!", err) ;
  180.     else
  181.     sv_setiv( ST(0), (IV)RETVAL);
  182.     }
  183.     XSRETURN(1);
  184. }
  185.  
  186. XS(XS_DynaLoader_dl_undef_symbols)
  187. {
  188.     dXSARGS;
  189.     if (items != 0) {
  190.     croak("Usage: DynaLoader::dl_undef_symbols()");
  191.     }
  192.     SP -= items;
  193.     {
  194.     PUTBACK;
  195.     return;
  196.     }
  197. }
  198.  
  199. XS(XS_DynaLoader_dl_install_xsub)
  200. {
  201.     dXSARGS;
  202.     if (items < 2 || items > 3) {
  203.     croak("Usage: DynaLoader::dl_install_xsub(perl_name, symref, filename=\"$Package\")");
  204.     }
  205.     {
  206.     char *    perl_name = (char *)SvPV(ST(0),na);
  207.     void *    symref = (void *)SvIV(ST(1));
  208.     char *    filename;
  209.  
  210.     if (items < 3)
  211.         filename = "DynaLoader";
  212.     else {
  213.         filename = (char *)SvPV(ST(2),na);
  214.     }
  215.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  216.         perl_name, symref));
  217.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  218.     }
  219.     XSRETURN(1);
  220. }
  221.  
  222. XS(XS_DynaLoader_dl_error)
  223. {
  224.     dXSARGS;
  225.     if (items != 0) {
  226.     croak("Usage: DynaLoader::dl_error()");
  227.     }
  228.     {
  229.     char *    RETVAL;
  230.     RETVAL = LastError ;
  231.     ST(0) = sv_newmortal();
  232.     sv_setpv((SV*)ST(0), RETVAL);
  233.     }
  234.     XSRETURN(1);
  235. }
  236.  
  237. XS(boot_DynaLoader)
  238. {
  239.     dXSARGS;
  240.     char* file = __FILE__;
  241.  
  242.     newXS("DynaLoader::dl_load_file", XS_DynaLoader_dl_load_file, file);
  243.     newXS("DynaLoader::dl_find_symbol", XS_DynaLoader_dl_find_symbol, file);
  244.     newXS("DynaLoader::dl_undef_symbols", XS_DynaLoader_dl_undef_symbols, file);
  245.     newXS("DynaLoader::dl_install_xsub", XS_DynaLoader_dl_install_xsub, file);
  246.     newXS("DynaLoader::dl_error", XS_DynaLoader_dl_error, file);
  247.  
  248.     /* Initialisation Section */
  249.  
  250.     (void)dl_private_init();
  251.  
  252.  
  253.     /* End of Initialisation Section */
  254.  
  255.     ST(0) = &sv_yes;
  256.     XSRETURN(1);
  257. }
  258.